home *** CD-ROM | disk | FTP | other *** search
/ Scene 96 / Scene 96 International Edition (Zyklop Software) (Disc 2) (1997).iso / misc / coding / vgacodng / part06_b.pas < prev    next >
Pascal/Delphi Source File  |  1996-11-22  |  4KB  |  132 lines
  1. program PCX2RAW;
  2.  
  3. uses crt;
  4.  
  5. type TPCXHeader = record               { Header der PCX-Datei }
  6.                     Manuf,Version,Encode,BitsPerPixel : byte;
  7.                     X1,Y1,X2,Y2,Xres,Yres : integer;
  8.                     Palette          : array[0..47] of byte;
  9.                     VideoMode,Planes : byte;
  10.                     BytesPerLine     : integer;
  11.                     Reserved         : array[0..59] of byte;
  12.                   end;
  13.      PPCXPic = ^TPCXPic;
  14.      TPCXPic = record
  15.                  Header  : TPCXHeader;            { Der Header }
  16.                  Palette : array[0..767] of byte; { Die Palette }
  17.                  Pixels  : pointer;               { Das Bild }
  18.                end;
  19.  
  20. var PCX_        : TPCXPic;
  21.     I           : integer;
  22.     palf,rawf   : file;
  23.     PCX,PAL,RAW : string;
  24.  
  25. procedure LoadPCX(FileName:string;var PCX:TPCXPic); { Lädt PCX-Datei }
  26. var F               : file;
  27.     Buf             : array[0..1024] of byte;
  28.     BufPtr,Off,Size : word;
  29.     Code,Count      : byte;
  30.  
  31. begin
  32.   assign(F,FileName);
  33.   reset(F,1);
  34.   blockread(F,PCX.Header,sizeof(PCX.Header)); { Header einlesen }
  35.   with PCX.Header do                          { und auswerten }
  36.     if (Manuf <> 10) or (Version <> 5) or (Encode <> 1) or
  37.        (BitsPerPixel <> 8) or (Planes <> 1) or
  38.        (BytesPerLine > 320) or (Y2 - Y1 > 199) then begin
  39.       PCX.Pixels := nil;               { Bild kann nicht dargestellt werden }
  40.       exit;
  41.     end;
  42.   Size := PCX.Header.BytesPerLine * succ(PCX.Header.Y2 - PCX.Header.Y1);
  43.   { Bildgröße ermitteln }
  44.   getmem(PCX.Pixels,Size);
  45.   if PCX.Pixels = nil then exit;
  46.   BufPtr := sizeof(Buf);
  47.   Off := 0;                            { Offset in der PCX-Datei }
  48.   while Off < Size do begin
  49.     if BufPtr >= sizeof(Buf) then begin
  50.       blockread(F,Buf,sizeof(Buf));    { Daten lesen }
  51.       BufPtr := 0;
  52.     end;
  53.     Code := Buf[BufPtr];
  54.     inc(BufPtr);
  55.     if Code shr 6 = 3 then begin       { Dekomprimierung }
  56.       Count := Code and 63;
  57.       if BufPtr >= sizeof(Buf) then begin
  58.         blockread(F,Buf,sizeof(Buf));
  59.         BufPtr := 0;
  60.       end;
  61.       Code := Buf[BufPtr];
  62.       inc(BufPtr);
  63.       fillchar(mem[Seg(PCX.Pixels^):ofs(PCX.Pixels^)+Off],Count,Code);
  64.       inc(Off,Count);
  65.     end
  66.     else begin
  67.       mem[seg(PCX.Pixels^):ofs(PCX.Pixels^)+Off] := Code;
  68.       inc(Off);
  69.     end;
  70.   end;
  71.   if BufPtr >= sizeof(Buf) then begin
  72.     blockread(F,Buf,sizeof(Buf));
  73.     BufPtr := 0;
  74.   end;
  75.   Code := Buf[BufPtr];
  76.   inc(BufPtr);
  77.   if Code = 12 then begin
  78.     for Off := 0 to 767 do begin
  79.       if BufPtr >= sizeof(Buf) then begin
  80.         blockread(F,Buf,767-Off);
  81.         BufPtr := 0;
  82.       end;
  83.       PCX.Palette[Off] := Buf[BufPtr];
  84.       inc(BufPtr);
  85.     end;
  86.   end;
  87.   close(F);
  88. end;
  89.  
  90. procedure FreePCX(var PCX:TPCXPic);
  91. begin
  92.   if PCX.Pixels <> nil then
  93.     freemem(PCX.Pixels,PCX.Header.BytesPerLine*succ(PCX.Header.Y2-PCX.Header.Y1));
  94. end;
  95.  
  96.  
  97. begin
  98.   if paramcount <> 2 then halt;
  99.   PCX := paramstr(1);                  { Name der PCX-Datei }
  100.   RAW := paramstr(2);                  { Name der RAW-Datei }
  101.   PAL := RAW;                          { Name der PAL-Datei }
  102.   delete(PAL,pos('.',PAL),4);          { eventuelle RAW-Endung entfernen }
  103.   PAL := PAL + '.pal';                 { Endung '.PAL' anhängen }
  104.   LoadPCX(PCX,PCX_);                   { PCX-Datei laden }
  105.   if PCX_.Pixels = nil then begin      { Fehler beim Laden }
  106.     writeln(#13#10'Error reading PCX file: ',PCX);
  107.     halt;
  108.   end;
  109.   asm mov ax,13h; int 10h end;         { Modus 13h setzen }
  110.   port[$3C8] := 0;                     { Palette setzen }
  111.   for I := 0 to 767 do begin
  112.     PCX_.Palette[I] := PCX_.Palette[I] shr 2;
  113.     Port[$3C9] := PCX_.Palette[I];
  114.   end;
  115.   with PCX_ do                         { Bild darstellen }
  116.     for I := Header.Y1 to Header.Y2 do
  117.       Move(mem[seg(PCX_.Pixels^):ofs(PCX_.Pixels^)+I*Header.BytesPerLine],
  118.            mem[$A000:320*I],Header.X2 - Header.X1 + 1);
  119.   assign(rawf,RAW);                    { Dateien vorbereiten }
  120.   rewrite(rawf,1);
  121.   assign(palf,PAL);
  122.   rewrite(palf,1);
  123.   with PCX_ do                         { RAW-File schreiben }
  124.     for I := Header.Y1 to Header.Y2 do
  125.       blockwrite(rawf,mem[$A000:320*I],Header.X2 - Header.X1 + 1);
  126.   blockwrite(palf,PCX_.Palette,768);   { PAL-File schreiben }
  127.   readkey;
  128.   close(rawf);
  129.   close(palf);
  130.   textmode(3);
  131. end.
  132.